perm filename PLTIT.OLD[MSS,LCS] blob
sn#131223 filedate 1974-11-15 generic text, type T, neo UTF8
C**** PLTCMD, FILLMS, ROTATE ********
SUBROUTINE PLTCMD
CC IMPLICIT INTEGER(A-Q,S-Z)
COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
DIMENSION NMS(8),RMOV1(8),RMOV2(8)
COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(NMS(1),INP(31))
1,(RMOV1(1),INP(39))
C BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
CC 1,(RMOV1(1),INP(21)),(RMOV2(1),INP(31))
F78F(1)='(78F)'
FA5(1)='(A5) '
FA1(1)='(A1) '
IF(I2.NE.'X')GO TO 1
I2=0
RXC=0
RMOV1(1)='Y'
NAME=0
14 KA=0
3 KA=KA+1
IF(ML.EQ.0)GO TO 15
K=K-2
ML=ML-1
IF(ML.EQ.0)GO TO 10
GO TO 31
15 TYPE 2,KA
ACCEPT 11,K,ML
C TYPE LAST NAME, NUMBER FOR A SERIES
50 IF(K.EQ.' ')GO TO 10
IF(K.EQ.'99')GO TO 140
C 99=BACKUP
31 IF(LOOKD(K))GO TO 56
C JUMP IF FILE FOUND
TYPE 55
GO TO 15
55 FORMAT(' FILE NOT FOUND'/)
11 FORMAT(A5,I)
56 NMS(KA)=K
IF(ML.EQ.0)GO TO 5
RJH='Y'
GO TO 21
5 TYPE 8
ACCEPT FA5,RJH
IF(RJH.EQ.'99')GO TO 15
IF(RJH.NE.'Y')RJH=0
IF(RJH.EQ.0)REREAD F78F,RJH
C MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21 RMOV1(KA+1)=RJH
RMOV2(KA)=RJH
GO TO 3
140 KA=KA-1
GO TO 15
10 KB=KA-1
IF(I3.NE.'G')GO TO 22
RSIZ=1
GO TO 222
22 TYPE 9
ACCEPT F78F,RSIZ
IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
222 KA=0
1 IF(NAME.NE.0)GO TO 12
IF(KA.EQ.KB)CALL PLOT(0,0,99)
NAME=NMS(KA+1)
TYPE 111,NAME
RETURN
12 KA=KA+1
NAME=0
C 'PXC' = CALCOMP OUTPUT
RJH=0
RJB=RSIZ
RJC=RSIZ
C FOR FILLER. SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
RJG=0
RJE=1
RJF=1
IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
IF(RMOV1(KA).NE.0)RJE=0
IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
2 FORMAT(' TYPE FILE NAME',I2,1X$)
8 FORMAT(' MOVE UP AT END? ',$)
9 FORMAT(' SIZE FACTOR? ',$)
111 FORMAT(1XA5/)
END
C****** CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
COMMON/DL/RSIZ,SAVER,NAME
COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
DIMENSION IDAT(1)
COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
C MD=DISPLAY MP=PLOTTER MX=XGP
DX=DIS
RX=RHT
D=RSTJC*RJF
R=RSTJC*RJG
4 GO TO 1
C=CC
B=BB
C SAVES IT. IT WILL RETURN LATER.
BB=B/DIS
CC=1000
1 KK=0
DO 205 J=1,L
CALL UNPACK(M,N,IDAT(J))
KK=KK+1
NX(KK)=0
IF(LL.EQ.3)NX(KK)=3
X(KK)=ROFF((RJB+D*M)*DIS)
Y(KK)=ROFF((CENTR+R*N)*RHT)
3 GO TO 205
Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
C FOR DISTORTION
205 CONTINUE
NX(1)=KK
DIS=1.0
RHT=DIS
IF(IPLT)M=RSIZ+.4
IF(M.LE.0)M=1
C STOPS DISTORTION IN 'LINES'
2 CALL FILLER(X,Y,NX,M)
DIS=DX
RHT=RX
5 RETURN
C NEXT TO RESET DISTORTION FACT.
BB=B
CC=C
RETURN
END
SUBROUTINE ROTATE(I,L)
DIMENSION I(1)
COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
RJG=RJG*RSTJC
RJF=RJF*RSTJC
N=I(L)
KNT=601
C ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
I(KNT)=N
DO 1 K=L+1,N+L-1
CALL UNPACK(J,M,I(K))
X=J*RJF
Y=M*RJG
JJ=I(K)/100000000
AX=ATAN2(X,Y)*57.29578
HYP=SQRT(X**2+Y**2)
ROT=DEG+AX
J=ROFF(HYP*COSD(ROT))
M=ROFF(HYP*SIND(ROT))
KNT=KNT+1
IF(J)J=1000-J
IF(M)M=1000-M
1 I(KNT)=M*10000+J+JJ*100000000
L=601
RJF=1.
RJG=1.
RSTJC=1.
C SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
END
SUBROUTINE PLOT(I,J,K)
DATA M/1024/
DIMENSION N(1024)
IF(K.EQ.99)GO TO 1
L=L+1
CALL PAC(N(L),I)
3 IF(L.LT.1024)RETURN
2 WRITE(1)L,N
L=0
RETURN
1 WRITE(1)L,(N(K),K=1,L)
CALL EXIT
END